home *** CD-ROM | disk | FTP | other *** search
/ Gigarom 1 / Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso / FILES / DEV / I-Z / Xlisp_Source.cpt / Step10.LSP < prev    next >
Lisp/Scheme  |  1985-04-27  |  9KB  |  247 lines
  1. ;+
  2. ;               STEP 1.0 : (C) Copyright 1985 by Gregory Frascadore
  3. ;
  4. ;   This software may be copied, distributed to others, and modified as long
  5. ;   as it is not sold for profit, and as long as this copyright notice is
  6. ;   retained intact. For further information regarding STEP, contact the 
  7. ;   author at:
  8. ;               frascado%umn-cs.CSNET   (on CSNET)
  9. ;               75106,662               (on CompuServe)
  10. ;-
  11.  
  12. ;+
  13. ;                               STEP 1.0
  14. ; DESCRIPTION
  15. ;   STEP is an interactive debugging tool for use with XLISP 1.4 . With 
  16. ;   modification, STEP may work with later versions of XLISP or with other
  17. ;   lisp systems.
  18. ;
  19. ; UPDATE HISTORY
  20. ;   Version 1.0 - Original version, March 1985 by Gregory Frascadore.
  21. ; 
  22. ;-
  23.  
  24. ;+
  25. ; Here is where the global symbols are given values. Global symbols are
  26. ; distinguished from other symbols by their starting and ending asterisks.
  27. ; ie *global* . Function parameters start with an asterisk, but do not end
  28. ; with one ie *foo. Local symbols (like those in do, and let) end in asterisks
  29. ; ie bar*
  30. ;-  
  31. (setq *step-inprompt* '?            ; Each instep is identified by leading '?'
  32.       *step-outprompt* '=           ; Outsteps have leading '='
  33.       *step-count* 0                ; How many steps to make without prompting.
  34.       *step-indent* 0               ; The initial amount of indentation.
  35.       *step-indent-incr* 2          ; How much more to indent at each new level
  36.       *step-keys* nil               ; List of breakpoint atoms
  37.       *step-transparent* t          ; Flag, determines when to print to user.
  38.       *evalhookfnc* '(lambda (*sexpr) (eval *sexpr)) )
  39.                                     ; The initial evalhook is a nop function.
  40.  
  41. ;+
  42. ; step
  43. ;   Turns on stepping or sets breakpoints.
  44. ;   
  45. ; format
  46. ;   (step [<atom>]...)  -if no atoms are specified, stepping begin immediately.
  47. ;-       
  48. (defun step (&rest *keys)
  49.  
  50.     (if *keys                        
  51.         (setq *step-keys* *keys     
  52.               *step-transparent* t )
  53.         (setq *step-transparent* nil) )
  54.  
  55.     (setq *step-count* 0                            
  56.           *step-indent* 0 )
  57.  
  58.     (rplacd *evalhookfnc* (cdr stepper))    ; Set stepper as evalhookfnc
  59.     (setq *evalhook* *evalhookfnc*) t)      ; then start intercepting evals.
  60.  
  61. ;+
  62. ; nostep
  63. ;   Turns off stepping.
  64. ;
  65. ; format
  66. ;   (nostep)
  67. ;       returns t always
  68. ;-
  69. (defun nostep ()
  70.     (rplacd *evalhookfnc* '((*sexpr) (eval *sexpr))) t)
  71.  
  72.  
  73. (defun stepper (*sexpr)
  74.  
  75. ; If the car of the expression being evaluated is in the breakpoint list
  76. ; then take the stepper out of transparent mode.
  77.  
  78.     (if (and (consp *sexpr)
  79.              (member (car *sexpr) *step-keys*) )
  80.                      (setq *step-transparent* nil))
  81.  
  82. ; Start indenting at a deeper level. If the indent is in some weird state
  83. ; restore it to a level 1 indent ie 0 + incr.
  84.  
  85.     (if (<= *step-indent* 0)
  86.             (setq *step-indent* *step-indent-incr*)
  87.             (setq *step-indent* (+ *step-indent-incr* *step-indent*)) )
  88.  
  89. ; Eval the current *sexpr. If we are at level 1, set a catch we can throw
  90. ; to from deeper levels. Otherwise just do a simple step-evel. When completing
  91. ; a level 1 eval, turn off transparency and restore the evalhookfnc if they
  92. ; were disabled from a deeper level.
  93.  
  94.     (prog1
  95.         (cond ((eql *step-indent* *step-indent-incr*)
  96.                 (prog1
  97.                     (catch '*step-toplevel* (step-eval *sexpr))
  98.                     (setq *step-count* 0)
  99.                     (cond ((eql *step-transparent* 'c) 
  100.                                 (setq *step-transparent* nil)
  101.                                 (rplacd *evalhookfnc* (cdr stepper)) ) ) ) )
  102.  
  103.               (t (step-eval *sexpr)) )
  104.         (setq *step-indent* (- *step-indent* *step-indent-incr*)) ) )
  105.  
  106.  
  107. (defun step-eval (*sexpr)
  108.  
  109. ; Eval the current *sexpr. If *step-count* is greater than 0, do not prompt
  110. ; the user for instructions, but do continue to produce output if not in
  111. ; transparent mode.
  112.  
  113.     (cond ((zerop *step-count*)
  114.             (if (not *step-transparent*)
  115.                 (prog2
  116.                     (step-prompt *step-inprompt* *sexpr)
  117.                     (step-prompt *step-outprompt* (step-docmd *sexpr))
  118.                     (terpri) )
  119.                 (evalhook *sexpr stepper nil) ) )
  120.  
  121.           ((> *step-count* 0)
  122.             (setq *step-count* (1- *step-count*))
  123.             (if (not *step-transparent*)
  124.                 (prog2
  125.                     (progn 
  126.                         (step-prompt *step-inprompt* *sexpr)(terpri))
  127.                         (step-prompt *step-outprompt* 
  128.                                      (evalhook *sexpr stepper nil))(terpri) )
  129.                     (evalhook *sexpr stepper nil) ) )
  130.  
  131.           (t (break "%Error, Stepper loses")) ) )
  132.  
  133.  
  134.  
  135. (defun step-docmd (*sexpr)
  136.  
  137. ; If the *sexpr is an atom, don't bother asking the user what to do. Just echo
  138. ; the atom and its value. If its not an atom, ask the user what to do until
  139. ; he gives you a legal responce that either continues or aborts the evaluation.
  140.  
  141.     (do* (cmd*  (value* (cond ((atom *sexpr) (terpri) (eval *sexpr))
  142.                             (t '*unbound*) )))
  143.          ((cond ((boundp 'value*) t)
  144.                 (t (setq cmd* (step-getcmd)) nil) )
  145.                     value*)
  146.  
  147.             (case cmd*
  148.  
  149.             '(?     (step-help))
  150.  
  151.             '(+     (let ((key* (read)))
  152.                                 (if (atom key*)
  153.                                          (setq *step-keys* 
  154.                                                (cons key* *step-keys*) ) 
  155.                                          (step-huh?) ) ))
  156.  
  157.             '(-     (let ((key* (read)))
  158.                                 (if (atom key*)
  159.                                          (setq *step-keys*
  160.                                                (remove key* *step-keys*) )
  161.                                          (step-huh?) ) ))
  162.  
  163.             '(b     (break "STEP BREAK, type 'continue' or 'quit' when done"))
  164.  
  165.             '(c     (setq *step-transparent* 'c)
  166.                       (setq value* (evalhook *sexpr stepper nil)) )
  167.  
  168.             '(e     (throw '*step-toplevel* t))
  169.  
  170.             '(g     (rplacd *evalhookfnc* '((*sexpr) (eval *sexpr)))
  171.                       (setq *step-transparent* 'c)
  172.                       (setq value* (eval *sexpr)) )
  173.  
  174.             '(h     (step-help))
  175.  
  176.             '(n     (setq value* (eval *sexpr)))
  177.  
  178.             '(q     (setq *step-keys* nil)
  179.                       (rplacd *evalhookfnc* '((*sexpr) (eval *sexpr)))
  180.                       (throw '*step-toplevel* t) )
  181.  
  182.             '(s    (setq value* (evalhook *sexpr stepper nil)))
  183.                            
  184.             '(x     (throw '*step-toplevel* t) )
  185.  
  186.             '(t     (cond ((numberp cmd*)
  187.                                 (setq *step-count* cmd*)
  188.                                 (setq value* (evalhook *sexpr stepper nil)) )
  189.                           (t (step-huh?)) ) ) ) ) )
  190.                
  191.  
  192.  
  193. (defun step-getcmd ()
  194.  
  195. ; Since XLISP normally prompts '>' when asking for input, we add another
  196. ; '>' here to distinguish a stepper prompt. ie stepper prompts >>
  197.  
  198.     (princ " >")
  199.     (read))
  200.  
  201. (defun step-prompt (*prompt *sexpr)
  202.  
  203. ; Here we print the *sexpr with a informative leading character (usually
  204. ; either ? or = ). If the *sexpr is long then we won't print the whole thing
  205. ; just an outline which abbreviates nested lists as (...)
  206.  
  207.    (spaces *step-indent*)
  208.    (princ *prompt)
  209.  
  210.    (let ((len (flatc *sexpr)))
  211.             (cond ((<= (- len *step-indent*) 75)
  212.                         (princ *sexpr) )
  213.                   (t (short-princ *sexpr)) ) )
  214.    *sexpr ) 
  215.  
  216.  
  217. (defun step-help ()
  218.  
  219.     (princ "Here is a summary of the available commands:\n")
  220.     (princ "      s   - steps once more\n")
  221.     (princ "      ?   - prints this help\n")
  222.     (princ "      b   - enter a break loop\n")
  223.     (princ "      c   - continue program until next breakpoint\n")
  224.     (princ "      e   - exit program, return to toplevel\n")
  225.     (princ "      g   - go on without further stepping interruptions\n")
  226.     (princ "      h   - prints this help\n")
  227.     (princ "      n   - continue stepping, but no deeper\n")
  228.     (princ "      q   - quit program, clear breakpoints, return to toplevel\n")
  229.     (princ "      x   - exit, same as e\n")
  230.     (princ "      #   - make # steps at once\n")
  231.     (princ " + <atom> - add this atom to list of breakpoints\n")
  232.     (princ " - <atom> - remove this atom from list of breakpoints\n" ) )
  233.  
  234.  
  235. (defun step-huh? ()
  236.     (princ "Huh?  Type h or ? for help ") )
  237.  
  238.  
  239. ;+
  240. ; The End.
  241. ;-
  242.  
  243.         
  244.   
  245.                
  246.  
  247.